COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Data structures
C00003 00003	  NNSEARCH
C00008 00004	  BOB, BWB
C00011 00005	  DISTANCE, DISLOOP, QUERY
C00015 00006	  MAKETREE
C00022 00007	  GETSPREAD
C00025 00008	  GETDVAL
C00030 00009	  NWSORT, RLSORT, NWBOUNDS, NWHUNK, NWNODE
C00032 00010	  Test
C00036 00011	  Known bugs
C00037 ENDMK
C⊗;
; Data structures

	;Tree node
	II == 0
	XX  TVAL		;The value
	XX  DISCRIM		;Discriminating direction (if -1, the left
				;  son is the bucket of hunks.)
	XX  TLEFT		;Left son
	XX  TRIGHT		;Right son
	NODESZ == II/2

	;Hunk 
	II == 0
	XX  HLOW		;Array of 3 low values
	XX  HLOW2
	XX  HLOW3
	XX  HHIGH		;Array of 3 high values
	XX  HHIGH2
	XX  HHIGH3
	XX  HNEXT		;For linked buckets
	HUNKSZ == II/2

	;Sort cell
	II == 0
	XX  SCVAL		;The value
	XX  SCNEXT		;The next one
	SCSIZ == II/2

SOUGHT:	.BLKW 3			;The point being sought
NEAREST: 0			;The nearest so far found.
;  NNSEARCH

COMMENT ⊗ Does a nearest neighbor search in NNTREE restricted by
bounds arrays NNLOWS and NNHIGHS to see how close the point at SOUGHT
(a global location) is to any hunk in the tree.  This is a recursive
procedure, and at each call returns R0 = 0 if it is worth continuing
the search (based on Bounds-Within-Ball tests).  ⊗

ROUTINE NNSEARCH,<NNTREE,NNLOWS,NNHIGHS>
	TST	NNTREE(RF)	;Tree null?
	BNE	NNS1		;No
NNS3:	CLR	R0		;But ought to continue.
	RTS	RF		;Done
NNS1:	MOV	R2,-(SP)	;Save R2
	MOV	NNTREE(RF),R2	;R2 ← Tree
	TST	DISCRIM(R2)	;DISCRIM = -1?
	BGE	NNS2		;No
	CALL	QUERY,<TLEFT(R2)>	;Yes.  At base of tree.  Query.
	CALL	BWB,<NNLOWS(RF),NNHIGHS(RF)>	;See if worth continuing.
	MOV	(SP)+,R2	;Restore R2
	TST	R0		;So caller won't have to.
	RTS	RF		;And return
NNS2:
	MOV	#3,R0		;Make a NEWS array
	JSR	PC,GTFREE	;
	MOV	R0,-(SP)	;Save LOC[NEWS]
	MOV	DISCRIM(R2),R1	;
	CMP	SOUGHT(R1),TVAL(R2)	;Which side?
	BGT	NNS6		;

	;left side first
	MOV	NNHIGHS(RF),R1	;NEWS ← NNHIGHS
	MOV	(R1)+,(R0)+	;
	MOV	(R1)+,(R0)+	;
	MOV	(R1),(R0)	;
	MOV	(SP),R0		;
	ADD	DISCRIM(R2),R0	;NEWS[DISCRIM] ← TVAL
	MOV	TVAL(R2),(R0)	;
	MOV 	(SP),R0		;
	CALL	NNSEARCH,<TLEFT(R2),NNLOWS(RF),R0>
	BNE	NNFAIL		;Don't continue if NNSEARCH failed.
	MOV	(SP),R0		;NEWS ← NNLOWS
	MOV	NNLOWS(RF),R1	;
	MOV	(R1)+,(R0)+	;
	MOV	(R1)+,(R0)+	;
	MOV	(R1),(R0)	;
	MOV	(SP),R0		;
	ADD	DISCRIM(R2),R0	;NEWS[DISCRIM] ← TVAL
	MOV	TVAL(R2),(R0)	;
	MOV	(SP),R0		;
	CALL	BOB,<R0,NNHIGHS(RF)>	;
	BNE	NNS5		;Don't look at other side if BOB fails.
	MOV	(SP),R0		;
	CALL	NNSEARCH,<TRIGHT(R2),R0,NNHIGHS(RF)>
	BNE	NNFAIL		;Don't continue if NNSEARCH failed
NNS5:	CALL	BWB,<NNLOWS(RF),NNHIGHS(RF)>
	BNE	NNFAIL		;Don't continue if BWB failed
NNSUC:	MOV	(SP)+,R0	;Release the NEWS array
	JSR 	PC,RLFREE	;
	MOV	(SP)+,R2	;Restore R2
	CLR	R0		;We succeed -- need to continue
	RTS	RF		;Return
NNFAIL:	MOV	(SP)+,R0	;Release the NEWS array
	JSR 	PC,RLFREE	;
	MOV	(SP)+,R2	;Restore R2
	MOV	#-1,R0		;We fail -- no need to continue
	RTS	RF		;Return

	;right side first
NNS6:	MOV	NNLOWS(RF),R1	;NEWS ← LOWS
	MOV	(R1)+,(R0)+	;
	MOV	(R1)+,(R0)+	;
	MOV	(R1),(R0)	;
	MOV	(SP),R0		;
	ADD	DISCRIM(R2),R0	;NEWS[DISCRIM] ← TVAL
	MOV	TVAL(R2),(R0)	;
	MOV 	(SP),R0		;
	CALL	NNSEARCH,<TRIGHT(R2),R0,NNHIGHS(RF)>
	BNE	NNFAIL		;Don't continue if NNSEARCH failed,
	MOV	(SP),R0		;NEWS ← NNHIGHS
	MOV	NNHIGHS(RF),R1	;
	MOV	(R1)+,(R0)+	;
	MOV	(R1)+,(R0)+	;
	MOV	(R1),(R0)	;
	MOV	(SP),R0		;
	ADD	DISCRIM(R2),R0	;NEWS[DISCRIM] ← TVAL
	MOV	TVAL(R2),(R0)	;
	MOV	(SP),R0		;
	CALL	BOB,<NNLOWS(RF),R0>	;
	BNE	NNFAIL		;Don't look at other side if BOB fails.
	MOV	(SP),R0		;
	CALL	NNSEARCH,<TLEFT(R2),NNLOWS(RF),R0>
	BNE	NNFAIL		;Terminate as in the other case
	BR	NNS5		;
;  BOB, BWB

ROUTINE BOB,<BBLOWS,BBHIGHS>
COMMENT  ⊗  Returns in R0 tested 0 iff worth continuing,
that is, the bounds do overlap the ball. ⊗
	MOV	R2,-(SP)	;Save R2
	MOV	R3,-(SP)	;Save R3
	MOV	BBLOWS(RF),R2	;R2 ← LOC[BBLOWS];
	MOV	BBHIGHS(RF),R3	;R3 ← LOC[BBHIGHS]
	JSR	PC,DISLOOP	;
	MOV	(SP)+,R3	;Restore R3
	MOV	(SP)+,R2	;Restore R2
	CMP	R0,NEAREST	;Overlap?
	BGT	BOB1		;No.
	CLR	R0		;Yes.
BOB1:	RTS	RF		;


ROUTINE BWB,<BWLOWS,BWHIGHS>
COMMENT ⊗ Ball-within-bounds test.  Returns R0 = 0 iff it is worth
continuing, that is, the current NEAREST radius about SOUGHT does not
fall completely within the given bounds.  ⊗
	MOV	R2,-(SP)	;Save R2
	CLR	R0		;R0 ← dimension number (0,2,4)
BWB2:	MOV	SOUGHT(R0),R1	;R1 ← SOUGHT[DIMENSION]
	MOV	BWLOWS(RF),R2	;
	ADD	R0,R2		;
	MOV	(R2),R2		;
	ADD	NEAREST,R2	;R2 ← LOWBOUNDS[DIMENSION] + NEAREST
	CMP	R1,R2		;
	BLE	BWB1		;Can exit
	MOV	BWHIGHS(RF),R2	;
	ADD	R0,R2		;
	MOV	(R2),R2		;
	SUB	NEAREST,R2	;R2 ← HIGHBOUNDS[DIMENSION] - NEAREST
	CMP	R1,R2		;
	BGE	BWB1		;Can exit
	TST	(R0)+		;
	CMP	R0,#4		;
	BLE	BWB2		;Repeat if necessary.  Else, within bounds.
BWB3:	MOV	(SP)+,R2	;Restore R2
	TST	R0		;So caller won't have to
	RTS	RF		;Done
BWB1:	CLR	R0		;Not within bounds.  Ought to continue search.
	BR	BWB3		;Done
;  DISTANCE, DISLOOP, QUERY

COMMENT ⊗ Takes a pointer to a hunk in R0.  Returns the distance from
that hunk to SOUGHT in R0.  Actually, as soon as the distance is sure
to be greater than NEAREST, it just returns the current sum (which
will be an underestimate larger than NEAREST) ⊗

DISTANCE:
	MOV	R2,-(SP)	;Save R2
	MOV	R3,-(SP)	;Save R3
	MOV	R0,R2		;
	ADD	#HLOW,R2	;R2 ← LOC[HLOW];
	MOV	R0,R3		;
	ADD	#HHIGH,R3	;R3 ← LOC[HHIGH];
	JSR	PC,DISLOOP	;
	MOV	(SP)+,R3	;Restore R3
	MOV	(SP)+,R2	;Restore R2
	RTS	PC		;Done


DISLOOP:
COMMENT ⊗ R2 ← LOC[HLOW], R3 ← LOC[HHIGH].  Returns distance from
SOUGHT to these arrays in R0.  Actually, as soon as the distance is
sure to be greater than NEAREST, it just returns the current sum
(which will be an underestimate larger than NEAREST) ⊗
	MOV 	R4,-(SP)	;Save R4
	CLR	R0		;R0 ← cumulative distance
	CLR	R4		;R4 ← Dimension number (0,2,4)
DIS1:	MOV	R2,R1		;
	ADD	R4,R1		;
	MOV	(R1),R1		;
	SUB	SOUGHT(R4),R1	;R1 ← HLOW[DIMENSION] - SOUGHT[DIMENSION]
	BGT	DIS2		;Below the left border?
	MOV	R3,R1		;no.
	ADD	R4,R1		;
	MOV	(R1),R1		;
	SUB	SOUGHT(R4),R1	;R1 ← SOUGHT[DIMENSION] - HHIGH[DIMENSION]
	BLT	DIS2		;Above the right border?
	CLR	R1		;No.  Distance is 0.
DIS2:	MUL	R1,R1		;R1 ← Distance squared
	ADD	R1,R0		;
	CMP	R0,NEAREST	;Greater already than NEAREST?
	BGT	DIS4		;yes
DIS3:	TST	(R4)+		;no
	CMP	R4,#4		;
	BLE	DIS1		;Repeat for other dimensions
DIS4:	MOV	(SP)+,R4	;Restore R4
	RTS 	PC		;Done

ROUTINE QUERY,<QHUNK>
COMMENT ⊗ Takes a pointer to a bucket of hunks.  Calls DISTANCE on
each entry in the bucket.  ⊗

	MOV	QHUNK(RF),R0	;
	BEQ	QUERY1		;End of list?
	MOV	HNEXT(R0),QHUNK(RF)	;No
	JSR	PC,DISTANCE	;Get the distance.
	CMP	NEAREST,R0	;Have we gotten closer?
	BLE	QUERY		;No.  check the next in the bucket
	MOV	R0,NEAREST	;Yes.  A new nearest.
	BNE	QUERY		;If not 0, go do it again.
QUERY1:	RTS	RF		;Done
;  MAKETREE

BSIZE:	10			;Number of hunks per bucket

ROUTINE MAKETREE,<MTLIST,MTLOW,MTHIGH>

COMMENT ⊗ Makes a tree out of the hunks in the MTLIST assuming that
they all lie in the bounds.  Will put from 1 to BSIZE hunks in each
bucket.  Returns the LOC[root node] in R0.  Recursive.  ⊗

	;initialize local variables
	DISC == -4		;  ie, can say DISC(RF)
	DVAL == -6		;  ie, can say DVAL(RF)
	LEFT == -10		;  ie, can say LEFT(RF)
	RIGHT == -12		;  ie, can say RIGHT(RF)
	CLR	-(SP)		;DISC(RF) ← 0;
	CLR	-(SP)		;DVAL(RF) ← 0;
	CLR	-(SP)		;LEFT(RF) ← 0;
	CLR	-(SP)		;RIGHT(RF) ← 0;
	MOV	R2,-(SP)	;Save R2
	MOV	R3,-(SP)	;Save R3
	MOV	R4,-(SP)	;Save R4
	MOV	MTLIST(RF),R0	;R0 ← List of hunks
	BNE	MT1		;If any
	JMP	MT9		;Do the return fixup, return R0 = 0.

MT1:	;see if we have less then BSIZ hunks.
	MOV	BSIZE,R1	;R1 ← Count
MT12:	MOV	HNEXT(R0),R0	;R0 ← next hunk
	BEQ	MT13		;If any
	SOB	R1,MT12		;
	BR	MT10		;
MT13:	CALL	NWNODE,<R1,#-1,MTLIST(RF),R1>	;Put all hunks in bucket
	JMP	MT9		;Do the return fixup

	;Set DISC to direction of greatest spread;
MT10:	CLR	R4		;R4 ← SPREAD ← 0
	DEC	DISC(RF)	;-1 is the initial discrim.
	CLR	R3		;R3 ← Initialize the dimension (0,2,4)
MT3:	MOV	MTLOW(RF),R0	;
	ADD	R3,R0		;R0 ← LOWBOUNDS[DIMENSION]
	MOV	MTHIGH(RF),R1	;
	ADD	R3,R1		;R1 ← HIGHBOUNDS[DIMENSION]
	CALL	GETSPREAD,<MTLIST(RF),R3,(R0),(R1)>
	CMP	R0,R4		;A wider spread?
	BLE	MT2		;No
	MOV	R0,R4		;
	MOV	R3,DISC(RF)	;
MT2:	TST	(R3)+		;
	CMP	R3,#4		;
	BLE	MT3		;Repeat for each dimension

	;take care of full region case
	TST	DISC(RF)	;Discrim = -1?
	BGE	MT4		;No
	CLR	R0		;
	CALL	NWNODE,<R0,DISC(RF),MTLIST(RF),R0>	;Yes.
	JMP	MT9		;Do the return fixup

MT4:	MOV	MTLOW(RF),R0	;
	ADD	DISC(RF),R0	;R0 ← LOWBOUNDS[DISCRIM]
	MOV	MTHIGH(RF),R1	;
	ADD	DISC(RF),R1	;R1 ← HIGHBOUNDS[DISCRIM]
	CALL	GETDVAL,<MTLIST(RF),DISC(RF),(R0),(R1)>
	MOV	R0,DVAL(RF)		;

	;Unzip the MTLIST into two chains.
	JSR	PC,NWHUNK
	MOV	R0,LEFT(RF)	;
	MOV	R0,R4		;R4 is the PTRL
	JSR	PC,NWHUNK
	MOV	R0,RIGHT(RF)	;
	MOV	R0,R3		;R3 is the PTRR
	MOV	MTLIST(RF),R2	;R2 is the PTR

MT8:	MOV	R2,R1		;
	ADD	#HHIGH,R1	;
	ADD	DISC(RF),R1	;
	CMP	(R1),DVAL(RF)	;HHIGH[PTR][DISCRIM] ≤ DVAL?
	BGT	MT5		;No
	MOV	R2,HNEXT(R4)	;Yes. Put this hunk on the left chain.
	MOV	R2,R4		;
	BR	MT7		;
MT5:	MOV	R2,R1		;
	ADD	#HLOW,R1	;
	ADD	DISC(RF),R1	;
	CMP	(R1),DVAL(RF)	;HLOW[PTR][DISCRIM] ≥ DVAL?
	BLT	MT6		;No
	MOV	R2,HNEXT(R3)	;Yes. Put this hunk on the right chain.
	MOV	R2,R3		;
	BR	MT7		;

MT6:	;Must chop the hunk in two
	JSR	PC,NWHUNK	;Make a new left hunk
	MOV	R0,HNEXT(R4)	;Link it in
	MOV	R0,R4		;
	MOV	R2,R1		;Copy the bounds
	ADD	#HLOW,R1	;
	ADD	#HLOW,R0	;
	MOV	R3,-(SP)	;
	MOV	#6,R3		;
MT11:	MOV	(R1)+,(R0)+	;
	SOB	R3,MT11		;
	MOV	(SP)+,R3	;
	MOV	R4,R0		;Put in new highbound(discrim) ← dval
	ADD	DISC(RF),R0	;
	MOV	DVAL(RF),HHIGH(R0)
	MOV	R2,HNEXT(R3)	;Use the old hunk for the right.  Link it in.
	MOV	R2,R3		;
	MOV	R2,R0		;Put in new lowbound(discrim) ← dval
	ADD	DISC(RF),R0	;
	MOV	DVAL(RF),HLOW(R0)

MT7:	MOV	HNEXT(R2),R2	;
	BNE	MT8		;Repeat as necessary

	CLR	HNEXT(R4)	;Terminate new chains
	CLR	HNEXT(R3)	;
	JSR	PC,NWBOUNDS	;Recursive call on left chain
	MOV	R0,R2		;Save R2 ← LOC[NEWBOUNDS]
	MOV	MTHIGH(RF),R1	;
	MOV	(R1)+,(R0)+	;Copy the highbounds
	MOV	(R1)+,(R0)+	;
	MOV	(R1),(R0)	;
	MOV	R2,R0		;
	ADD	DISC(RF),R0	;
	MOV	DVAL(RF),(R0)	;  with HIGHBOUNDS[DISCRIM] ← DVAL
	MOV	LEFT(RF),R0		;
	CALL	MAKETREE,<HNEXT(R0),MTLOW(RF),R2>
	MOV	R0,R3		;R3 ← left subtree
	MOV	MTLOW(RF),R1	;Recursive call on right chain
	MOV	R2,R0		;
	MOV	(R1)+,(R0)+	;Copy the lowbounds
	MOV	(R1)+,(R0)+	;
	MOV	(R1),(R0)	;
	MOV	R2,R0		;
	ADD	DISC(RF),R0	;
	MOV	DVAL(RF),(R0)	;  with LOWBOUNDS[DISCRIM] ← DVAL
	MOV	RIGHT(RF),R0	;
	CALL	MAKETREE,<HNEXT(R0),R2,HHIGH(RF)>
	CALL	NWNODE,<DVAL(RF),DISC(RF),R3,R0>
MT9:	MOV	(SP)+,R4	;Restore R4
	MOV	(SP)+,R3	;Restore R3
	MOV	(SP)+,R2	;Restore R2
	ADD	#10,SP		;Clear off local variables
	RTS	RF		;Return the full node in R0.
;  GETSPREAD

ROUTINE GETSPREAD,<GTLIST,GTDIRECTION,GTLOW,GTHIGH>
COMMENT ⊗ Looks down the GTLIST of hunks, only examining the given
direction, and reports the greatest distance between the outlying
points.  If there are only points at LOWB and HIGHB, the result is
given as 0 instead of HIGHB-LOWB.  The answer is retured in R0.  ⊗
	MOV	R2,-(SP)	;Save R2
	MOV	R3,-(SP)	;Save R3
	MOV	R4,-(SP)	;Save R4
	MOV	GTHIGH(RF),R2	;Initialize the lowest we have seen
	MOV	GTLOW(RF),R3	;Initialize the highest we have seen
	MOV	GTDIRECTION(RF),R0	;
	MOV	GTLIST(RF),R4	;R4 ← PTR ← head of the list
	BEQ	GTS1		;if any
GTS4:	MOV	#HLOW,R1	;
	ADD	GTDIRECTION(RF),R1
	ADD	R4,R1		;
	MOV	(R1),R1		;
	MOV	R1,R0		;
	SUB	R2,R1		;R1 ← HLOW[DIRECTION] - LOWEST
	BGE	GTS2		;Not a new lowest
	MOV	R0,R2		;A new lowest
GTS2:	MOV	#HHIGH,R1	;
	ADD	GTDIRECTION(RF),R1
	ADD	R4,R1		;
	MOV	(R1),R1		;
	MOV	R1,R0		;
	SUB	R3,R1		;R1 ← HHIGH[DIRECTION] - HIGHEST
	BLE	GTS3		;Not a new highest
	MOV	R0,R3		;A new highest
GTS3:	MOV	HNEXT(R4),R4	;Look at next hunk
	BNE	GTS4		;If any
GTS1:	MOV	R3,R0		;
	SUB	R2,R0		;R0 ← HIGHEST - LOWEST
	MOV	GTHIGH(RF),R1	;
	SUB	GTLOW(RF),R1	;R1 ← GTHIGH - GLOW
	CMP	R0,R1		;Is the spread the maximum?
	BLT	GTS5		;No
	CLR	R0		;Load up a zero
GTS5:	MOV	(SP)+,R4	;Restore R4
	MOV	(SP)+,R3	;Restore R3
	MOV	(SP)+,R2	;Restore R2
	RTS 	RF		;And return
;  GETDVAL

CURHUNK:0		;The current hunk that GETDVAL is sorting
HEAD:	0		;Head of the list of sorted values

ROUTINE GETDVAL,<GDLIST,GDDIRECTION,GDLOW,GDHIGH>
COMMENT ⊗ Returns the value closest to the mean value of the list's
values in the given direction.  This is returned in R0.  ⊗

	;initialize
	MOV	R2,-(SP)	;Save R2
	MOV	R3,-(SP)	;Save R3
	MOV	R4,-(SP)	;Save R4
	MOV	GDLOW(RF),R0	;
	JSR	PC,NWSORT	;
	MOV	R0,R3		;
	MOV	R0,HEAD		;HEAD ← R3 ← NWSORTCELL(LOW) (head of insertion list)
	MOV	GDHIGH(RF),R0	;
	JSR	PC,NWSORT	;
	MOV	R0,SCNEXT(R3)	;SCNEXT[HEAD] ← NWSORTCELL(HIGH)
	CLR	SCNEXT(R0)	;Terminate the chain.

	;sort the values by insertion sort in a list
	MOV	GDLIST(RF),CURHUNK	;CURHUNK ← Current hunk
	BEQ	GDV1		;If any
GDV8:	MOV	HEAD,R3		;R3 ← PTRB ← HEAD
	MOV	SCNEXT(R3),R4	;R4 ← PTRF ← NEXT[PTRB]
	MOV	CURHUNK,R0	;
	ADD	#HLOW,R0	;
	ADD	GDDIRECTION(RF),R0
	MOV	(R0),R0		;
	MOV	R0,R2		;R2 ← VAL ← HLOW[CURHUNK][DIRECTION]
	JSR	PC,NWSORT	;R0 ← NWSORTCELL(VAL)
	CMP	R2,GDLOW(RF)	;If  VAL ≠ LOWB
	BEQ	GDV2		;
	CMP	R2,SCVAL(R4)	;find a place in sorted list
	BLE	GDV3		;
GDV4:	MOV	R4,R3		;
	MOV	SCNEXT(R4),R4	;
	CMP	R2,SCVAL(R4)	;
	BGT	GDV4		;
GDV3:	MOV	R4,SCNEXT(R0)	;the place is right between R3 and R4.
	MOV	R0,SCNEXT(R3)	;
	MOV	R0,R3		;a new PTRB
GDV2:	MOV	CURHUNK,R0	;
	ADD	#HHIGH,R0	;
	ADD	GDDIRECTION(RF),R0
	MOV	(R0),R0		;
	MOV	R0,R2		;R2 ← VAL ← HHIGH[CURHUNK][DIRECTION]
	JSR	PC,NWSORT	;R0 ← NWSORTCELL(VAL)
	CMP	R2,GDHIGH(RF)	;If  VAL ≠ HIGHB
	BEQ	GDV5		;
	CMP	R2,SCVAL(R4)	;find a place in sorted list
	BLE	GDV6		;
GDV7:	MOV	R4,R3		;
	MOV	SCNEXT(R4),R4	;
	CMP	R2,SCVAL(R4)	;
	BGT	GDV7		;
GDV6:	MOV	R4,SCNEXT(R0)	;the place is right between R3 and R4.
	MOV	R0,SCNEXT(R3) 	;
GDV5:	MOV	CURHUNK,R0	;
	MOV	HNEXT(R0),CURHUNK	;Go to next hunk
	BNE	GDV8		;If any

	;select the mean value
GDV1:	MOV	GDHIGH(RF),R0	;
	SUB	GDLOW(RF),R0	;
	ASR	R0		;R0 ← Mean value to aim for
	MOV	HEAD,R3		;R3 ← PTRB ← HEAD
	MOV	SCNEXT(R3),R4 	;R4 ← PTRF ← NEXT[HEAD]
	CMP	SCVAL(R4),R0	;Gone past yet?
	BGE	GDV12		;Yes.
GDV9:	MOV	R4,R3		;No.  Move to next one.
	MOV	SCNEXT(R4),R4	;
	CMP	SCVAL(R4),R0	;Gone past yet?
	BLT	GDV9		;No.  try next one.
GDV12:	CMP	SCVAL(R4),GDHIGH(RF)	;Did we get to very end?
	BNE	GDV10		;No.
	MOV	SCVAL(R3),R2	;Yes. The answer will be VAL[PTRB]
	BR	GDV11		;
GDV10:	MOV	SCVAL(R4),R2	;The answer will be VAL[PTRF]
GDV11:	MOV	HEAD,R0		;
	JSR	PC,RLSORT	;Get rid of all the sort cells
	MOV	R2,R0		;R0 ← answer
	MOV	(SP)+,R4	;Restore R4
	MOV	(SP)+,R3	;Restore R3
	MOV	(SP)+,R2	;Restore R2
	RTS	RF		;
;  NWSORT, RLSORT, NWBOUNDS, NWHUNK, NWNODE

NWSORT:
COMMENT ⊗ Takes an item in R0 which is to be placed as the SCVAL of a
new sort cell.  This cell is taken from large block space and is
pointed to by R0.  ⊗
	MOV	R0,-(SP)	;Save the datum
	MOV	#SCSIZ,R0	;
	JSR	PC,GTFREE	;R0 ← LOC[new sortcell]
	MOV	(SP)+,SCVAL(R0)	;Load up the SCVAL
	RTS	PC		;Done

RLSORT:
COMMENT ⊗ Takes a pointer to a sortcell in R0.  It and all the cells
linked to it are returned to large block space.  ⊗
	TST	R0		;Check if we were given a real cell
	BEQ	RLS1		;No.
RLS2:	MOV	SCNEXT(R0),-(SP);Save the next one for later.
	JSR	PC,RLFREE	;
	MOV	(SP)+,R0	;Get the next on the list
	BNE	RLS2		;If any, then repeat.
RLS1:	RTS	PC		;Done


NWHUNK:	MOV	#HUNKSZ,R0	;
	JSR	PC,GTFREE	;
	RTS	PC		;

NWBOUNDS:
	MOV	#3,R0		;
	JSR 	PC,GTFREE	;
	RTS	PC		;

ROUTINE NWNODE,<NNDVAL,NNDDIS,NNDLEF,NNDRIG>
	MOV	#NODESZ,R0	;
	JSR 	PC,GTFREE	;R0 ← LOC[new node]
	MOV	NNDVAL(RF),TVAL(R0)	;Stuff the values in
	MOV	NNDDIS(RF),DISCRIM(R0)	;
	MOV	NNDLEF(RF),TLEFT(R0)	;
	MOV	NNDRIG(RF),TRIGHT(R0)	;
	RTS	RF		;Done
;  Test

LOWS:	.BLKW	3		;Low universe bounds
HIGHS:	.BLKW	3		;High universe bounds
TREE:	.BLKW	1		;The tree in which we search

TEST:		(Since that is what HAL likes to call it)

.MACRO MAKEHUNK XL,XH,YL,YH,ZL,ZH,NXT
	JSR	PC,NWHUNK	;R0 ← LOC[new hunk]
	MOV	R0,R1		;
	MOV	XL,(R1)+	;Stuff in the low bounds
	MOV	YL,(R1)+	;Stuff in the low bounds
	MOV	ZL,(R1)+	;Stuff in the low bounds
	MOV	XH,(R1)+	;Stuff in the high bounds
	MOV	YH,(R1)+	;Stuff in the high bounds
	MOV	ZH,(R1)+	;Stuff in the high bounds
	MOV	NXT,(R1)	;Set the next pointer
.ENDM

	MAKEHUNK #1,#2, #3,#4, #5,#6,  #0
	MOV	R0,R2		;R2 is the list of all hunks
	MAKEHUNK #3,#4, #5,#6, #1,#2,  R2
	MOV	R0,R2		;
	MAKEHUNK #5,#6, #5,#6, #1,#2,  R2
	MOV	R0,R2		;
	MAKEHUNK #7,#10, #5,#6, #1,#2,  R2
	MOV	R0,R2		;
	MAKEHUNK #3,#4, #1,#2, #1,#2,  R2
	MOV	R0,R2		;
	MAKEHUNK #3,#4, #3,#4, #1,#2,  R2
	MOV	R0,R2		;
	MAKEHUNK #3,#4, #5,#6, #7,#10,  R2
	MOV	R0,R2		;
	MAKEHUNK #1,#2, #3,#4, #3,#4,  R2
	MOV	R0,R2		;
	MAKEHUNK #3,#4, #5,#6, #3,#4,  R2
	MOV	R0,R2		;
	MAKEHUNK #5,#6, #5,#6, #3,#4,  R2
	MOV	R0,R2		;
	MAKEHUNK #7,#10, #5,#6, #3,#4,  R2
	MOV	R0,R2		;
	MAKEHUNK #3,#4, #1,#2, #3,#4,  R2
	MOV	R0,R2		;
	MAKEHUNK #3,#4, #3,#4, #3,#4,  R2
	MOV	R0,R2		;
	MAKEHUNK #1,#7, #7,#8, #2,#5,  R2
	MOV	R0,R2		;
	
	JSR	PC,NWBOUNDS	;
	MOV	R0,LOWS		;LOWS ← R0 ← LOC[low bounds]
	CLR	(R0)+		;Set all low bounds to 0
	CLR	(R0)+		;
	CLR	(R0)+		;

	JSR	PC,NWBOUNDS	;
	MOV	R0,HIGHS		;HIGHS ← R0 ← LOC[high bounds]
	MOV	#10,R4		;
	MOV	R4,(R0)+	;Set all high bounds to 10
	MOV	R4,(R0)+	;
	MOV	R4,(R0)+	;

	CALL	MAKETREE,<R2,LOWS,HIGHS>
	MOV	R0,TREE		;
	MOV	#12,R5		;R5 ← Number of full tests (of =512 searches)
TSTA:	MOV	#10,R2		;X 
	MOV	R2,R3		;Y
	MOV	R2,R4		;Z
TSTX:	MOV	R2,SOUGHT	;
TSTY:	MOV	R3,SOUGHT+2	;
TSTZ:	MOV	R4,SOUGHT+4	;
	MOV	#200,NEAREST	;To initialize.
	CALL	NNSEARCH,<TREE,LOWS,HIGHS>
	SOB	R4,TSTZ		;
	MOV	#10,R4		;
	SOB	R3,TSTY		;
	MOV	#10,R3		;
	SOB	R2,TSTX		;
	SOB	R5,TSTA		;
	BPT			;
;  Known bugs

COMMENT ⊗
There is no call yet to BWB.
⊗